home *** CD-ROM | disk | FTP | other *** search
- 10000 '
- 10010 CLEAR ,,,,,300*1024 ' def font DLL 領域
- 10020 DEFINT A-Z
- 10030 DIM TBL#(99,1),TW_FNT$(25)
- 10040 DIM GR%(99) ' 後で再定義するが...
- 10050 PALETTE 0,[4*16,2*16,4*16] ' 背景色
- 10060 'GOSUB *FILE_NAME
- 10070 'END
- 10080 '
- 10090 P = 0
- 10100 READ F$:WHILE F$ <> "*"
- 10110 TW_FNT$(P) = F$
- 10120 P = P + 1
- 10130 READ F$:WEND
- 10140 TW_FNT_MAX = P
- 10150 DATA "システム 12ドット"
- 10160 DATA "システム 16ドット"
- 10170 DATA "明朝体 24ドット"
- 10180 DATA "ゴシック体 24ドット"
- 10190 DATA "教科書体 24ドット"
- 10200 DATA "まるもじ 24ドット"
- 10210 DATA "明朝体 32ドット"
- 10220 DATA "ゴシック体 32ドット"
- 10230 DATA "明朝体 48ドット"
- 10240 DATA "ゴシック体 48ドット"
- 10250 DATA "明朝体 60ドット"
- 10260 DATA "ゴシック体 60ドット"
- 10270 DATA "毛筆体 48ドット"
- 10280 'DATA "明朝体 ベクトル(ICカード)"
- 10290 'DATA "ゴシック体 ベクトル(ICカード)"
- 10300 'DATA "丸ゴシック体 ベクトル(ICカード)"
- 10310 DATA *
- 10320 CLS
- 10330 PRINT " --------------------------"
- 10340 PRINT " SYM_DOSV"
- 10350 PRINT " --------------------------"
- 10360 PRINT "TOWNSの多様なフォントを元に DOS/V用のフォントファイルを"
- 10370 PRINT "作成するものです."
- 10380 PRINT "全角フォントのみ対応しています."
- 10390 PRINT "フォントファイルに含まれる文字を指定するために,基準用のフォントファイルが"
- 10400 PRINT "必要です."
- 10410 PRINT "作成されたフォントファイルには 富士通の著作権がありますので 個人使用に"
- 10420 PRINT "止めてください。"
- 10430 PRINT
- 10440 '
- 10450 *TOP
- 10460 PRINT
- 10470 PRINT "◆TOWNS側使用フォント"
- 10480 PRINT " INSTALL していないフォントを使用するときは, SYSTEM CD をセットして"
- 10490 PRINT " ください."
- 10500 PRINT
- 10510 P = 0 :I$ = ""
- 10520 WHILE I$ <> CHR$(13)
- 10530 ' "丸ゴシック体 ベクトル(ICカード)"
- 10540 PRINT USING CHR$(13)+"使用フォント選択 <[& &]>";TW_FNT$(P);
- 10550 I$ = INPUT$(1)
- 10560 IF I$ = "6" OR I$ = CHR$(&H1C) THEN
- 10570 P = P + 1
- 10580 IF P = TW_FNT_MAX THEN P = 0
- 10590 ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
- 10600 P = P - 1
- 10610 IF P = -1 THEN P = TW_FNT_MAX -1
- 10620 ENDIF
- 10630 WEND
- 10640 PRINT
- 10650 SYM_FNT$ = TW_FNT$(P)
- 10660 '
- 10670 'X,Ysize
- 10680 PRINT
- 10690 PRINT "◆フォントサイズ"
- 10700 PRINT " 作成するフォントの縦横のドット数を指定します."
- 10710 PRINT
- 10720 P = 24
- 10730 I$ = ""
- 10740 WHILE I$ <> CHR$(13)
- 10750 PRINT USING CHR$(13)+"横ドット数(3-99) <[##]>";P;
- 10760 I$ = INPUT$(1)
- 10770 IF I$ = "6" OR I$ = CHR$(&H1C) THEN
- 10780 P = P + 1
- 10790 IF P = 100 THEN P = 99
- 10800 ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
- 10810 P = P - 1
- 10820 IF P = 2 THEN P = 3
- 10830 ENDIF
- 10840 WEND
- 10850 PRINT
- 10860 X_SIZE = P
- 10870 I$ = ""
- 10880 WHILE I$ <> CHR$(13)
- 10890 PRINT USING CHR$(13)+"縦ドット数(3-99) <[##]>";P;
- 10900 I$ = INPUT$(1)
- 10910 IF I$ = "6" OR I$ = CHR$(&H1C) THEN
- 10920 P = P + 1
- 10930 IF P = 100 THEN P = 99
- 10940 ELSE IF I$ = "4" OR I$ = CHR$(&H1D) THEN
- 10950 P = P - 1
- 10960 IF P = 2 THEN P = 3
- 10970 ENDIF
- 10980 WEND
- 10990 PRINT
- 11000 Y_SIZE = P
- 11010 PRINT
- 11020 PRINT "◆太文字指定"
- 11030 PRINT " 横に1ドット太いフォントを作成します."
- 11040 PRINT
- 11050 BOLD = 0
- 11060 I$ = " "
- 11070 WHILE I$ <> CHR$(13)
- 11080 IF BOLD = 0 THEN
- 11090 PRINT CHR$(13)+" [ 通常文字 ] 太 文 字 ";
- 11100 ELSE
- 11110 PRINT CHR$(13)+" 通常文字 [ 太 文 字 ]";
- 11120 ENDIF
- 11130 I$ = INPUT$(1)
- 11140 IF INSTR("46"+CHR$(&H1C)+CHR$(&H1D),I$) THEN
- 11150 BOLD = -(BOLD = 0)
- 11160 ENDIF
- 11170 WEND
- 11180 PRINT
- 11190 '
- 11200 PRINT
- 11210 PRINT "◆フォント名"
- 11220 PRINT " フォントファイルに書き込むフォント名を指定します."
- 11230 PRINT " 半角 8文字まで."
- 11240 PRINT
- 11245 PRINT "(省略時:TOWNS)"
- 11250 *F_NAME_IN
- 11260 PRINT "フォント名:";
- 11270 LINE INPUT N$
- 11280 IF N$ = "" THEN N$ = "TOWNS"
- 11290 IF LEN(N$) > 8 THEN GOTO *F_NAME_IN
- 11300 F_NAME$ = N$
- 11310 PRINT
- 11320 '
- 11330 PRINT
- 11340 PRINT "◆基準フォントファイル"
- 11350 PRINT " FONTEX用のフォントファイルを指定してください."
- 11360 PRINT " サイズの違うフォントファイルでもかまいません."
- 11370 PRINT " このファイルで使用している文字と同じ文字を含むフォントファイルを"
- 11380 PRINT " 作成します."
- 11390 PRINT
- 11400 FL_RDWT = 0
- 11410 GOSUB *FL_NAME
- 11420 I_FILE$ = FL_NAME$
- 11430 '
- 11440 PRINT
- 11450 PRINT "◆出力ファイル名"
- 11460 PRINT " 作成するファイル名です."
- 11470 PRINT " 同名ファイルがあるときは,バックアップファイルを作成します."
- 11480 PRINT
- 11490 FL_RDWT = 1
- 11500 GOSUB *FL_NAME
- 11510 O_FILE$ = FL_NAME$
- 11520 PRINT
- 11530 '
- 11540 PRINT ""
- 11550 PRINT "---------------------------------------------------------"
- 11560 PRINT " 使用フォント : ";SYM_FNT$
- 11570 PRINT " フォントサイズ : X=";X_SIZE;"dot Y=";Y_SIZE;"dot"
- 11580 PRINT " 太文字指定 : ";
- 11590 IF BOLD = 0 THEN PRINT "通常文字" ELSE PRINT "太 文 字"
- 11600 PRINT " フォント名 : ";F_NAME$
- 11610 PRINT " 基準フォントファイル : ";I_FILE$
- 11620 PRINT " 出力ファイル名 : ";O_FILE$
- 11630 PRINT "---------------------------------------------------------"
- 11640 PRINT " 以上の設定でよろしいですか."
- 11650 I = 0
- 11660 I$ = ""
- 11670 WHILE I$ <>CHR$(13)
- 11680 IF I = 0 THEN
- 11690 PRINT CHR$(13)+" [ 決 定 ] 再設定 ";
- 11700 ELSE
- 11710 PRINT CHR$(13)+" 決 定 [ 再設定 ] ";
- 11720 ENDIF
- 11730 I$ = INPUT$(1)
- 11740 IF INSTR("46"+CHR$(&H1D)+CHR$(&H1C),I$) THEN
- 11750 I = -(I=0)
- 11760 ENDIF
- 11770 WEND
- 11780 PRINT
- 11790 IF I = 1 THEN GOTO *TOP
- 11800 '---------------------------------------------------------------------------
- 11810 ' DOS/V font write
- 11820 '
- 11825 PRINT "----- フォントファイルを作成します -----"
- 11826 TIME$ = "00:00:00"
- 11830 DEF FONT SYM_FNT$
- 11840 FT_BYTS = INT((X_SIZE+7)/8) * Y_SIZE
- 11850 ERASE GR% : DIM GR%(FT_BYTS/2 + 1)
- 11860 CNT_X = INT(640/(X_SIZE+1)) ' bold 処理の為 +1
- 11870 CNT_Y = INT(460/(Y_SIZE))
- 11880 CNT_N = CNT_X * CNT_Y
- 11900 '
- 11910 '-- 基準用ファイルリード --
- 11920 PRINT " 基準ファイル読み込み"
- 11930 OPEN "I",#1,I_FILE$
- 11940 ' ID check
- 11950 I$ = INPUT$(6,1)
- 11960 IF I$ <> "FONTX2" THEN
- 11970 PRINT "FONTEX用フォントではありません。"
- 11980 GOTO *FONTEX_ERROR
- 11990 ENDIF
- 12000 ' FONT NAME
- 12010 I$ = INPUT$(8,1)
- 12020 PRINT " FONT NAME =" + I$
- 12030 ' FONT SIZE
- 12040 I$ = INPUT$(2,1)
- 12050 PRINT " SIZE: X = ## Y = ##";ASC(MID$(I$,1,1));ASC(MID$(I$,2,1))
- 12060 ' FONT TYPE
- 12070 I$ = INPUT$(1,1)
- 12080 IF I$ = CHR$(0) THEN
- 12090 CLS
- 12100 PRINT "半角のフォントファイルです。"
- 12110 GOTO *FONTEX_ERROR
- 12120 ENDIF
- 12130 ' 領域テーブル個数
- 12140 I$ = INPUT$(1,1)
- 12150 TBL_MAX = ASC(I$)
- 12160 PRINT " 領域数 =";TBL_MAX
- 12170 ' 領域テーブル読み込み
- 12180 FOR I = 0 TO TBL_MAX -1
- 12190 I$ = INPUT$(4,1)
- 12200 TBL#(I,0) = ASC(MID$(I$,2,1))*256 + ASC(MID$(I$,1,1))
- 12210 TBL#(I,1) = ASC(MID$(I$,4,1))*256 + ASC(MID$(I$,3,1))
- 12220 PRINT USING "[$& & - $& &] ";HEX$(TBL#(I,0));HEX$(TBL#(I,1));
- 12230 NEXT
- 12240 CLOSE #1
- 12250 PRINT
- 12260 '
- 12270 '-- 出力ファイルオープン --
- 12280 OPEN "O",#1,FL_NAME$
- 12290 ' ヘッダ書き込み
- 12300 PRINT #1,"FONTX2"; 'ID
- 12310 PRINT #1,LEFT$(F_NAME$+STRING$(8,CHR$(0)),8); 'フォント名
- 12320 PRINT #1,CHR$(X_SIZE)+CHR$(Y_SIZE); 'フォントサイズ 16x16
- 12330 PRINT #1,CHR$(1); 'フォントタイプ 全角
- 12340 PRINT #1,CHR$(TBL_MAX); '領域テーブル出力
- 12350 FOR I = 0 TO TBL_MAX -1 '
- 12360 PRINT #1,CHR$(TBL#(I,0)MOD 256)+CHR$(TBL#(I,0)\ 256);
- 12370 PRINT #1,CHR$(TBL#(I,1)MOD 256)+CHR$(TBL#(I,1)\ 256);
- 12380 NEXT
- 12390 ' フォント本体書き込み
- 12400 FX = 0:FY = 0
- 12410 CLS
- 12420 LINE (0,18)-(639,18),PSET
- 12430 FOR F = 0 TO TBL_MAX -1
- 12440 LOCATE 57,0
- 12450 PRINT USING "## / ## : & & - & &";TBL_MAX;F+1;HEX$(TBL#(F,0));HEX$(TBL#(F,1));
- 12460 FOR P = 0 TO TBL#(F,1)-TBL#(F,0)
- 12470 SJ_CODE# = TBL#(F,0) + P
- 12480 IF FX = 0 THEN
- 12490 LINE (0,FY*Y_SIZE+20)-STEP(639,Y_SIZE-1),PSET,0,BF
- 12500 ENDIF
- 12510 LOCATE 2,0
- 12520 PRINT USING "作業中 (& &) ... [ESC] 中止";HEX$(SJ_CODE#);
- 12530 IF BOLD = 0 THEN
- 12540 SYMBOL (FX*(X_SIZE+1),FY*Y_SIZE+20),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),X_SIZE/16,Y_SIZE/16
- 12550 ELSE ' BOLD
- 12560 SYMBOL (FX*(X_SIZE+1),FY*Y_SIZE+20),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),X_SIZE/16,Y_SIZE/16,,,,1
- 12570 ENDIF
- 12580 GET@ (FX*(X_SIZE+1),FY*Y_SIZE+20)-(FX*(X_SIZE+1)+X_SIZE-1,FY*Y_SIZE+20+Y_SIZE-1),GR%
- 12590 GR_AD& = VARPTR(GR%(0))
- 12600 FOR I = 0 TO FT_BYTS-1
- 12610 PRINT #1,CHR$(PEEK(GR_AD& + I));
- 12620 NEXT
- 12630 'I$ = ""
- 12640 'FOR I = 0 TO FT_TYTS
- 12650 ' I$ = I$ + CHR$(PEEK(GR_AD& + I))
- 12660 ' IF LEN(I$) > 250 THEN
- 12670 ' PRINT #1,I$;
- 12680 ' I$ = ""
- 12690 ' ENDIF
- 12700 'NEXT
- 12710 'IF LEN(I$)> 0 THEN PRINT #1,I$;
- 12720 ' グラフィック座標更新
- 12730 FX = FX + 1
- 12740 IF FX >= CNT_X THEN
- 12750 FX = 0
- 12760 FY = FY + 1
- 12770 IF FY >= CNT_Y THEN
- 12780 FY = 0
- 12790 ENDIF
- 12800 ENDIF
- 12810 I$ = INKEY$ ' 中止処理
- 12820 IF I$ = CHR$(&H1B) THEN
- 12830 P = TBL#(F,1)-TBL#(F,0)
- 12840 F = TBL_MAX -1
- 12850 ABORT = 1
- 12860 ENDIF
- 12870 NEXT
- 12880 NEXT
- 12890 *FONTEX_ERROR
- 12900 CLOSE #1
- 12910 CLS
- 12920 IF ABORT = 1 THEN
- 12930 KILL O_FILE$
- 12940 PRINT "作業を中止しました."
- 12950 QUIT = 0
- 12960 ELSE
- 12965 PRINT "作業時間 = " +TIME$
- 12970 PRINT "作業を終了しました。"
- 12980 QUIT = 1
- 12990 ENDIF
- 13000 ABORT = 0
- 13010 PRINT ""
- 13020 I$ = " "
- 13030 WHILE I$ <> CHR$(13)
- 13040 IF QUIT = 0 THEN
- 13050 PRINT CHR$(13)+" [ 再実行 ] 終了 ";
- 13060 ELSE
- 13070 PRINT CHR$(13)+" 再実行 [ 終了 ]";
- 13080 ENDIF
- 13090 I$ = INPUT$(1)
- 13100 IF INSTR("46"+CHR$(&H1C)+CHR$(&H1D),I$) THEN
- 13110 QUIT = -(QUIT = 0)
- 13120 ENDIF
- 13130 WEND
- 13140 PRINT
- 13150 IF QUIT = 0 THEN *TOP
- 13160 '
- 13170 '
- 13180 'SYSTEM
- 13190 END
- 18900 '---- ファイル名入力 -------------------------------------------------------
- 18910 *FL_NAME
- 18920 ' in fL_rdwt , fl_def$
- 18930 ' out fl_name$
- 18940 '
- 18950 IF FL_CDIR$ = "" THEN FL_CDIR$ = ".\"
- 18960 '
- 18970 *FL_NAME2
- 18980 PRINT FL_CDRV$ + FL_CDIR$+">";
- 18990 LINE INPUT FL_CLINE$
- 19000 '
- 19010 '入力で \ のかわりに / で入力できるように
- 19020 FOR FL_I = 1 TO LEN(FL_CLINE$)
- 19030 IF MID$(FL_CLINE$,FL_I,1) = "/" THEN MID$(FL_CLINE$,FL_I,1) = "\"
- 19040 NEXT
- 19050 '
- 19060 GOSUB *FL_PRM
- 19070 '
- 19080 'default
- 19090 IF FL_PRM$ = "" THEN
- 19100 IF FL_DEF$ <> "" THEN
- 19110 FL_PRM$ = FL_DEF$
- 19120 ELSE
- 19130 FL_PRM$ = "*.*"
- 19140 ENDIF
- 19150 ENDIF
- 19160 '
- 19170 'cls
- 19180 IF FL_PRM$ = "cls" OR FL_PRM$ = "CLS" THEN
- 19190 CLS 1
- 19200 GOTO *FL_NAME2
- 19210 ENDIF
- 19220 '
- 19230 'help
- 19240 IF FL_PRM$ = "help" OR FL_PRM$ = "HELP" OR FL_PRM$ = "?" THEN
- 19250 PRINT "---------------------------------------------------"
- 19260 PRINT " (*,?)を含む files"
- 19270 PRINT " drv: ドライブ変更"
- 19280 PRINT " [drv:]dir\ カレント変更 & files"
- 19290 PRINT " DIR [drv:]dir files"
- 19300 PRINT " CD [drv:]dir カレント変更"
- 19310 PRINT " DEL fname 削除"
- 19320 PRINT " REN fname fname リネーム"
- 19330 PRINT " TYPE fname ファイル表示"
- 19340 PRINT " CLS 画面消去"
- 19350 PRINT " HELP この表示"
- 19360 PRINT "---------------------------------------------------"
- 19370 PRINT " '-' のみの入力でファイル名入力を中断できます."
- 19380 PRINT " '\' の代わりに '/' を使って入力できます."
- 19390 PRINT " DEL, REN に ワイルドカードは使えません."
- 19400 PRINT " TYPE 表示中に [S] [SPACE] でポーズ, [P] [RET] でページストップ,"
- 19410 PRINT " [Q] [C] [ESC] で中断することができます."
- 19420 PRINT " カレントの変更は,ドライブ名を含めて指定できます."
- 19430 PRINT " ファイル名指定に '*','?' が含まれていると,該当のディレクトリを表示します."
- 19440 GOTO *FL_NAME2
- 19450 ENDIF
- 19460 '
- 19470 'del fname
- 19480 IF FL_PRM$ = "del" OR FL_PRM$ = "DEL" THEN
- 19490 GOSUB *FL_PRM
- 19500 GOSUB *FL_TGFILE
- 19510 GOSUB *FL_EXIST
- 19520 IF FL_EXIST = 1 THEN
- 19530 ON ERROR GOTO *FL_DEL_ER
- 19540 KILL FL_NAME$
- 19550 ON ERROR GOTO 0
- 19560 ELSE
- 19570 PRINT "ファイルがみつかりません."
- 19580 ENDIF
- 19590 GOTO *FL_NAME2
- 19600 ENDIF
- 19610 '
- 19620 'ren fname fname
- 19630 IF FL_PRM$ = "ren" OR FL_PRM$ = "REN" THEN
- 19640 GOSUB *FL_PRM : GOSUB *FL_TGFILE
- 19650 FL_OLD$ = FL_NAME$
- 19660 GOSUB *FL_PRM : GOSUB *FL_TGFILE
- 19670 'if fl_prm$ <> "" then
- 19680 ON ERROR GOTO *FL_REN_ER
- 19690 NAME FL_OLD$ AS FL_NAME$
- 19700 ON ERROR GOTO 0
- 19710 'ENDIF
- 19720 GOTO *FL_NAME2
- 19730 ENDIF
- 19740 '
- 19750 'type
- 19760 IF FL_PRM$ = "type" OR FL_PRM$ = "TYPE" THEN
- 19770 GOSUB *FL_PRM
- 19780 GOSUB *FL_TGFILE
- 19790 GOSUB *FL_TYPE
- 19800 GOTO *FL_NAME2
- 19810 ENDIF
- 19820 '
- 19830 'a: ドライブ変更
- 19840 IF LEN(FL_PRM$) = 2 AND RIGHT$(FL_PRM$,1) = ":" THEN
- 19850 FL_NAME$ = FL_PRM$ + ".\"
- 19860 GOSUB *FL_DIR_CK
- 19870 IF FL_EXIST = 1 THEN
- 19880 FL_CDRV$ = FL_PRM$
- 19890 FL_CDIR$ = ".\"
- 19900 ELSE
- 19910 PRINT "ドライブの指定が違います."
- 19920 ENDIF
- 19930 GOTO *FL_NAME2
- 19940 ENDIF
- 19950 '
- 19960 '
- 19970 'cd\ , cd.. -> cd \ , cd ..
- 19980 IF FL_PRM$ = "cd\" OR FL_PRM$ = "CD\" OR FL_PRM$ = "cd.." OR FL_PRM$ = "CD.." THEN
- 19990 FL_CLINE$ = MID$(FL_PRM$,3)
- 20000 FL_PRM$ = "cd"
- 20010 ENDIF
- 20020 '
- 20030 'cd dir
- 20040 IF FL_PRM$ = "cd" OR FL_PRM$ = "CD" THEN
- 20050 GOSUB *FL_PRM
- 20060 IF FL_PRM$ <> "" THEN
- 20070 IF RIGHT$(FL_PRM$,1) <> "\" THEN FL_PRM$ = FL_PRM$ + "\"
- 20080 GOSUB *FL_CDCHG
- 20090 ELSE
- 20100 PRINT FL_CDRV$+FL_CDIR$
- 20110 ENDIF
- 20120 GOTO *FL_NAME2
- 20130 ENDIF
- 20140 '
- 20150 'dir\ ディレクトリ変更 & files
- 20160 IF RIGHT$(FL_PRM$,1) = "\" THEN
- 20170 GOSUB *FL_CDCHG
- 20180 FL_PRM$ = "*.*"
- 20190 ENDIF
- 20200 '
- 20210 'dir
- 20220 IF FL_PRM$ = "dir" OR FL_PRM$ = "DIR" OR FL_PRM$ = "ls" THEN
- 20230 GOSUB *FL_PRM
- 20240 IF FL_PRM$ = "" THEN
- 20250 FL_PRM$ = "*.*"
- 20260 ENDIF
- 20270 GOSUB *FL_TGFILE
- 20280 ON ERROR GOTO *FL_DIR_ER
- 20290 FILES FL_NAME$
- 20300 ON ERROR GOTO 0
- 20310 GOTO *FL_NAME2
- 20320 ENDIF
- 20330 '
- 20340 'ファイル名に '*','?' が含まれる時 files
- 20350 FL_I = INSTR(FL_PRM$,"*") + INSTR(FL_PRM$,"?")
- 20360 IF FL_I <> 0 THEN
- 20370 GOSUB *FL_TGFILE
- 20380 ON ERROR GOTO *FL_DIR_ER
- 20390 FILES FL_NAME$
- 20400 ON ERROR GOTO 0
- 20410 ' 空き容量等の表示を消す
- 20420 'locate 0,csrlin -1
- 20430 'print chr$(13)+space$(78)+chr$(13);
- 20440 'locate 0,csrlin -1
- 20450 'print chr$(13)+space$(78)+chr$(13);
- 20460 GOTO *FL_NAME2
- 20470 ENDIF
- 20480 '
- 20490 '-' 中止確認
- 20500 IF FL_PRM$ = "-" THEN
- 20510 FL_NAME$ = "-"
- 20520 GOTO *FL_NAME_T
- 20530 ENDIF
- 20540 '
- 20550 ' ファイル確認,終了処理
- 20560 GOSUB *FL_TGFILE
- 20570 GOSUB *FL_EXIST
- 20580 IF FL_RDWT = 0 THEN ' 読み込みのとき ファイル存在確認
- 20590 IF FL_EXIST = 0 THEN
- 20600 PRINT "指定のファイルはみつかりません."
- 20610 GOTO *FL_NAME2
- 20620 ENDIF
- 20630 ELSE ' 書き込みの時 同名ファイルをリネーム
- 20640 IF FL_EXIST = 1 THEN
- 20650 'ファイル名のみ切り出す
- 20660 FL_I = INSTR(FL_NAME$,"\") ' '\'があるか
- 20670 IF FL_I <> 0 THEN 'あり
- 20680 FL_I = LEN(FL_NAME$) -1
- 20690 WHILE MID$(FL_NAME$,FL_I,1) <> "\"
- 20700 FL_I = FL_I -1
- 20710 WEND
- 20720 FL_BAK$ = MID$(FL_NAME$,FL_I+1)
- 20730 ELSE
- 20740 FL_BAK$ = FL_NAME$
- 20750 ENDIF
- 20760 FL_I = INSTR(FL_BAK$,".")
- 20770 IF FL_I = 0 THEN
- 20780 FL_BAK$ = FL_BAK$ + ".bak" '拡張子なし
- 20790 ELSE
- 20800 FL_BAK$ = LEFT$(FL_BAK$,FL_I-1)+".bak" '拡張子を変更
- 20810 ENDIF
- 20820 ON ERROR GOTO *FL_SKIP
- 20830 KILL FL_BAK$
- 20840 ON ERROR GOTO 0
- 20850 NAME FL_NAME$ AS FL_BAK$
- 20860 ENDIF
- 20870 ENDIF
- 20880 IF LEFT$(FL_NAME$,2) = ".\" THEN
- 20890 FL_NAME$ = MID$(FL_NAME$,3)
- 20900 ENDIF
- 20910 *FL_NAME_T
- 20920 RETURN
- 20930 '
- 20940 '-- file_sub ---
- 20950 *FL_SKIP
- 20960 RESUME NEXT '削除cancel
- 20970 '
- 20980 *FL_TGFILE
- 20990 ' 対象ファイル名を fl_name$ にセット
- 21000 ' in fl_prm$ (fl_cdrv$,fl_cdir$) out fl_name$
- 21010 'drv
- 21020 IF MID$(FL_PRM$,2,1) <> ":" THEN
- 21030 FL_NAME$ = FL_CDRV$
- 21040 ELSE
- 21050 FL_NAME$ = LEFT$(FL_PRM$,2)
- 21060 FL_PRM$ = MID$(FL_PRM$,3)
- 21070 ENDIF
- 21080 'dir
- 21090 IF LEFT$(FL_PRM$,1) = "\" THEN ' フルパス指定
- 21100 FL_NAME$ = FL_NAME$ + FL_PRM$
- 21110 ELSE IF LEFT$(FL_PRM$,3) = "..\" THEN ' 上ディレクトリ
- 21120 FL_I = INSTR(LEFT$(FL_CDIR$,LEN(FL_CDIR$)-1),"\") ' '\'が二つ以上か確認
- 21130 IF FL_I <> 0 THEN
- 21140 FL_I = LEN(FL_CDIR$) -1
- 21150 WHILE MID$(FL_CDIR$,FL_I,1) <> "\"
- 21160 FL_I = FL_I -1
- 21170 WEND
- 21180 'fl_cdir$ = left$(fl_cdir$,fl_i)
- 21190 FL_NAME$ = FL_NAME$ + LEFT$(FL_CDIR$,FL_I) + MID$(FL_PRM$,4)
- 21200 ELSE
- 21210 FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
- 21220 ENDIF
- 21230 ELSE ' カレント+指定
- 21240 IF FL_CDRV$ = FL_NAME$ THEN
- 21250 FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
- 21260 ELSE
- 21270 FL_NAME$ = FL_NAME$ + FL_PRM$
- 21280 ENDIF
- 21290 ENDIF
- 21300 RETURN
- 21310 '
- 21320 *FL_CDCHG
- 21330 ' ディレクトリ確認, 更新
- 21340 ' in fl_prm$ (fl_cdir$,fl_cdrv$) out fl_cdir$, fl_cdrv$
- 21350 GOSUB *FL_TGFILE
- 21360 ' ディレクトリ存在確認
- 21370 GOSUB *FL_DIR_CK
- 21380 IF FL_EXIST = 1 THEN
- 21390 IF MID$(FL_NAME$,2,1) = ":" THEN
- 21400 FL_CDRV$ = LEFT$(FL_NAME$,2)
- 21410 FL_NAME$ = MID$(FL_NAME$,3)
- 21420 ENDIF
- 21430 FL_CDIR$ = FL_NAME$
- 21440 ELSE
- 21450 PRINT "ディレクトリの指定が違います."
- 21460 ENDIF
- 21470 RETURN
- 21480 '
- 21490 *FL_PRM
- 21500 ' fl_cline$ より 1項目 取り出す
- 21510 ' in fl_cline$ out fl_prm$ ,fl_cline$
- 21520 IF FL_CLINE$ <>"" THEN
- 21530 WHILE LEFT$(FL_CLINE$,1) = " "
- 21540 FL_CLINE$ = MID$(FL_CLINE$,2)
- 21550 WEND
- 21560 FL_I = INSTR(FL_CLINE$," ")
- 21570 IF FL_I <> 0 THEN
- 21580 FL_PRM$ = LEFT$(FL_CLINE$,FL_I-1)
- 21590 FL_CLINE$ = MID$(FL_CLINE$,FL_I+1)
- 21600 ELSE
- 21610 FL_PRM$ = FL_CLINE$
- 21620 FL_CLINE$ = ""
- 21630 ENDIF
- 21640 WHILE LEFT$(FL_CLINE$,1) = " "
- 21650 FL_CLINE$ = MID$(FL_CLINE$,2)
- 21660 WEND
- 21670 ELSE
- 21680 FL_PRM$ = ""
- 21690 ENDIF
- 21700 RETURN
- 21710 '
- 21720 *FL_TYPE
- 21730 ' ファイル内容表示 255文字以上は切捨て
- 21740 'in fl_name$
- 21750 FL_CNT = -1
- 21760 GOSUB *FL_EXIST
- 21770 IF FL_EXIST = 1 THEN
- 21780 OPEN "I",#9,FL_NAME$
- 21790 FL_BRK = 0: FL_CNT = -1
- 21800 WHILE EOF(9) = 0 AND FL_BRK = 0
- 21810 LINE INPUT #9,FL_I$
- 21820 PRINT FL_I$
- 21830 FL_I$ = INKEY$
- 21840 FL_CNT = FL_CNT + (FL_CNT>0)
- 21850 IF FL_CNT = 0 THEN FL_I$ = "p"
- 21860 IF FL_I$ = "" THEN
- 21870 ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
- 21880 FL_BRK = 1
- 21890 ELSE IF INSTR("PpSs "+CHR$(13),FL_I$) THEN
- 21900 FL_I$ = INPUT$(1)
- 21910 IF INSTR("Pp"+CHR$(13),FL_I$) THEN
- 21920 FL_CNT = 22
- 21930 ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
- 21940 FL_BRK = 1
- 21950 ELSE
- 21960 FL_CNT = -1
- 21970 ENDIF
- 21980 ENDIF
- 21990 WEND
- 22000 CLOSE #9
- 22010 ELSE
- 22020 PRINT "ファイルがみつかりません."
- 22030 ENDIF
- 22040 RETURN
- 22050 '
- 22060 *FL_EXIST
- 22070 'ファイル存在確認
- 22080 'in fl_name$ out fl_exist 1 ..ファイルあり 0 .. ファイルなし
- 22090 FL_EXIST = 1
- 22100 'print "f_EXIST ";fl_name$
- 22110 ON ERROR GOTO *FL_EXIST3
- 22120 OPEN "I",#9,FL_NAME$
- 22130 CLOSE #9
- 22140 *FL_EXIST2
- 22150 ON ERROR GOTO 0
- 22160 RETURN
- 22170 *FL_EXIST3
- 22180 IF ERR = 63 OR ERR = 75 OR ERR = 55 THEN
- 22190 FL_EXIST = 0
- 22200 ELSE
- 22210 PRINT ERR,ERL
- 22220 ENDIF
- 22230 RESUME *FL_EXIST2
- 22240 '
- 22250 *FL_DIR_CK
- 22260 ' ディレクトリ存在確認
- 22270 ' in fl_name$ out fl_exist
- 22280 FL_EXIST = 0
- 22290 ON ERROR GOTO *FL_DIR_CK_3
- 22300 OPEN "O",#9,FL_NAME$+"nul" :CLOSE #9
- 22310 *FL_DIR_CK_2
- 22320 ON ERROR GOTO 0
- 22330 RETURN
- 22340 *FL_DIR_CK_3
- 22350 IF ERR = 72 THEN
- 22360 PRINT "指定されたディスク装置が使用可能な状態になっていません."
- 22370 ELSE IF ERR = 75 THEN
- 22380 PRINT "デバイスまたはファイルのアクセスが拒否されました."
- 22390 ELSE IF ERR = 63 THEN
- 22400 'print "指定のディレクトリがみつかりません."
- 22410 ELSE IF ERR = 64 OR ERR = 73 THEN
- 22420 FL_EXIST = 1
- 22430 ELSE IF ERR = 55 THEN
- 22440 'ファイルの記述に誤りがあります
- 22450 ELSE
- 22460 PRINT ERR,ERL
- 22470 STOP
- 22480 ENDIF
- 22490 RESUME *FL_DIR_CK_2
- 22500 ' 63 指定のファイルがみつかりません
- 22510 ' 64 指定のファイルはすでに存在しています
- 22520 ' 72 指定されたディスク装置が使用可能な状態になっていません
- 22530 ' 73 指定されたディスクは書き込みが禁止されています
- 22540 ' 75 デバイスまたはファイルのアクセスが拒否されましてた
- 22550 ' 55 ファイルの記述に誤りがあります
- 22560 '
- 22570 '-- 各エラー処理 --
- 22580 *FL_DIR_ER
- 22590 PRINT "ファイルがみつかりません."
- 22600 RESUME NEXT
- 22610 '
- 22620 *FL_DEL_ER
- 22630 PRINT "ファイルを削除できません."
- 22640 RESUME NEXT
- 22650 '
- 22660 *FL_REN_ER
- 22670 PRINT "ファイル名が重複しているか, またはファイルがみつかりません."
- 22680 RESUME NEXT
- 22690 '